home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / ODE / obj_stack < prev    next >
Encoding:
Text File  |  1991-10-24  |  3.3 KB  |  154 lines
  1. \ OBJECT Stack =========================================
  2. \ This stack is used for storing the current object address.
  3. \ Access to instance variables is based on that address.
  4. \ This code is a good candidate for optimization.
  5. \
  6. \ Author: Phil Burk
  7. \ Copyright 1986 Delta Research
  8. \
  9. \ MOD: PLB 1/21/87 Add OS.DEPTH
  10. \ MOD: PLB 2/10/87 Assemble and optimize OS.PUSH and OS.DROP
  11. \ MOD: PLB 4/19/87 Optimize for Mac too.
  12. \ MOD: PLB 4/26/88 Add OS_MAX_DEPTH
  13. \ MOD: MDH 7/9/88 Use variable reference in OS.PUSH and OS.DROP
  14. \      for CLONE.
  15. \ MOD: PLB 4/26/91 Optimized OS.COPY
  16.  
  17. ANEW TASK-OBJ_STACK
  18.  
  19. 256 constant OS_SIZE
  20.  
  21. VARIABLE OBJECT-STACK os_size VALLOT
  22.  
  23. os_size cell/ constant OS_MAX_DEPTH
  24.  
  25. ( Hyphens had to be removed to prevent Mac assembler from crashing.)
  26. VARIABLE OSSTACKPTR
  27. VARIABLE OSTOP        \ this is a copy of the top of the object stack
  28. \ the actual top is also on the real stack
  29.  
  30. : OS.SP!  ( -- , Set Object Stack Pointer )
  31.     object-stack os_size + osstackptr !
  32. ; OS.SP!
  33.  
  34. \ These three words need to be optimized for object speed.
  35. \ : OS.PUSH  ( N -- , Push onto object stack )
  36. \    dup ostop !
  37. \    osstackptr @ cell-  ( predecrement )
  38. \    dup osstackptr !    ( update pointer )
  39. \    !            ( write value )
  40. \ ;
  41. \ : OS.DROP  ( -- , drop top of object stack )
  42. \    osstackptr @
  43. \    cell+
  44. \    dup @ ostop !  ( cache )
  45. \    osstackptr !
  46. \ ;
  47.  
  48. #host_amiga_jforth
  49. .IF
  50.  
  51. ASM    OS.DROP   ( -- )
  52.     lea        [ OSSTACKPTR here - 2- ](PC),a0    \ &OSSTACKPTR in A0
  53.     move.l    (a0),d0                    \ REL stack ptr in D0
  54.     add.l    #4,d0
  55.     lea        [ OSTOP HERE - 2- ](PC),A1
  56.     move.l    $0(org,d0.l),(a1)         \ update cache
  57.     move.l    d0,(a0)
  58. END-CODE
  59.  
  60. \ WARNING - do NOT change D2 or D3 because OB.BIND.RUN assumes it isn't
  61. ASM OS.PUSH  ( n1 -- )
  62.     lea        [ OSTOP HERE - 2- ](PC),A0
  63.     move.l    tos,(A0)
  64.     lea        [ OSSTACKPTR HERE - 2- ](PC),a0    \ a0 = &osstackptr
  65.     move.l    (a0),d0        \ &top of stack
  66.     subq.l  #$4,d0
  67.     move.l  tos,$0(org,d0.l)
  68.     move.l  d0,(a0)
  69.     move.l  (dsp)+,tos
  70. END-CODE
  71.  
  72. \ : OS.COPY  ( -- N , make copy of top of object stack )
  73. \    ostop @
  74. \ ;   ( must be fast for objects )
  75.  
  76. ASM OS.COPY  ( -- n , get from OSTOP )
  77.     move.l    tos,-(dsp)
  78.     move.l    [ OSTOP HERE - 2- ](pc),tos
  79. END-CODE
  80.  
  81.  
  82. DECIMAL
  83. \ This could probably be optimized )
  84. : OS+ ( M -- N+M , add top of object stack )
  85.     os.copy +
  86. ;
  87.  
  88. \ OS+PUSH is used for instance object binding.
  89. : OS+PUSH ( N -- , combine OS+ and OS.PUSH )
  90.     os+ os.push
  91. ;
  92. .THEN
  93.  
  94. #HOST_MAC_MACH2 .IF
  95. ALSO ASSEMBLER
  96. CODE OS.PUSH  ( N -- , Push onto object stack )
  97.     MOVE.L OSSTACKPTR,A0
  98.     MOVE.L  (A6)+,-(A0)
  99.     MOVE.L A0,OSSTACKPTR
  100.     RTS
  101. END-CODE
  102.  
  103. CODE OS.DROP  ( -- , drop top of object stack )
  104.     ADDQ.L #$4,OSSTACKPTR
  105.     RTS
  106. END-CODE
  107.  
  108. CODE OS.COPY  ( -- N , make copy of top of object stack )
  109.     MOVE.L OSSTACKPTR,A0
  110.     MOVE.L (A0),-(A6)
  111.     RTS
  112. END-CODE
  113.  
  114. ONLY MAC ALSO FORTH
  115. CODE OS+ ( M -- N+M , add top of object stack )
  116.     MOVE.L OSSTACKPTR,A0
  117.     ADD.L (A0),(A6)
  118.     RTS
  119. END-CODE
  120.  
  121. CODE OS+PUSH  ( N -- , Add to OS TOP and push onto object stack )
  122.     MOVE.L OSSTACKPTR,A0
  123.     MOVE.L (A0),D0  ( Get top. )
  124.     ADD.L  (A6)+,D0
  125.     MOVE.L D0,-(A0)
  126.     MOVE.L A0,OSSTACKPTR
  127.     RTS
  128. END-CODE
  129.  
  130. .THEN
  131.  
  132. : OS.POP  ( -- N , pop from object stack )
  133.     os.copy  os.drop
  134. ;
  135.  
  136. : OS.DEPTH ( -- #cells , depth of object stack )
  137.     object-stack os_size +
  138.     osstackptr @ - cell/
  139. ;
  140.  
  141. : OS.PICK ( n -- Vn , pick value off object stack )
  142.     cell* osstackptr @ + @
  143. ;
  144.  
  145. \ Benchmark
  146. if-testing @ .IF
  147. VARIABLE #OS.BENCH
  148. 1000 #OS.BENCH !
  149. : OS.BENCH  123 #OS.BENCH @ 0
  150.     DO  os.push os.copy os.drop
  151.     LOOP drop
  152. ;
  153. .THEN
  154.